home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / ag68kmit.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  26KB  |  638 lines
  1. {
  2.     $Id: ag68kmit.pas,v 1.1.1.1.2.4 1998/09/14 18:55:48 carl Exp $
  3.     Copyright (c) 1998 by the FPC development team
  4.  
  5.     This unit implements an asmoutput class for MIT syntax with
  6.     Motorola 68000 (for MIT syntax TEST WITH GAS v1.34)
  7.  
  8.     This program is free software; you can redistribute it and/or modify
  9.     it under the terms of the GNU General Public License as published by
  10.     the Free Software Foundation; either version 2 of the License, or
  11.     (at your option) any later version.
  12.  
  13.     This program is distributed in the hope that it will be useful,
  14.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.     GNU General Public License for more details.
  17.  
  18.     You should have received a copy of the GNU General Public License
  19.     along with this program; if not, write to the Free Software
  20.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22.  ****************************************************************************
  23.  
  24.   What's to do:
  25.     o Verify if this actually work as indirect mode with name of variables
  26.     o write lines numbers and file names to output file
  27.     o generate debugging informations
  28. }
  29.  
  30. unit ag68kmit;
  31.  
  32.     interface
  33.  
  34.     uses aasm,assemble;
  35.  
  36.     type
  37.       pm68kmitasmlist=^tm68kmitasmlist;
  38.       tm68kmitasmlist = object(tasmlist)
  39.         procedure WriteTree(p:paasmoutput);virtual;
  40.         procedure WriteAsmList;virtual;
  41.       end;
  42.  
  43.    implementation
  44.  
  45.     uses
  46.       dos,globals,systems,cobjects,m68k,
  47.       strings,files,verbose
  48. {$ifdef GDB}
  49.       ,gdb
  50. {$endif GDB}
  51.       ;
  52.  
  53.     const
  54.       line_length = 70;
  55.  
  56.     var
  57.       infile : pextfile;
  58.       includecount,lastline : longint;
  59.  
  60.     function getreferencestring(const ref : treference) : string;
  61.       var
  62.          s : string;
  63.       begin
  64.          s:='';
  65.          if ref.isintvalue then
  66.              s:='#'+tostr(ref.offset)
  67.          else
  68.            with ref do
  69.              begin
  70.                   { symbol and offset }
  71.                   if (assigned(symbol)) and (offset<>0) then
  72.                     Begin
  73.                       s:=s+'('+tostr(offset)+symbol^;
  74.                     end
  75.                   else
  76.                   { symbol only }
  77.                   if (assigned(symbol)) and (offset=0) then
  78.                     Begin
  79.                       s:=s+'('+symbol^;
  80.                     end
  81.                   else
  82.                   { offset only }
  83.                   if (symbol=nil) and (offset<>0) then
  84.                     Begin
  85.                       s:=s+'('+tostr(offset);
  86.                     end
  87.                   else
  88.                   { NOTHING - put zero as offset }
  89.                   if (symbol=nil) and (offset=0) then
  90.                     Begin
  91.                       s:=s+'('+'0';
  92.                     end
  93.                   else
  94.                    InternalError(10004);
  95.                   if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then
  96.                    InternalError(10004)
  97.                 else if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then
  98.                 begin
  99.                   if (scalefactor = 1) or (scalefactor = 0) then
  100.                     Begin
  101.                       if offset<>0 then
  102.                         s:=mit_reg2str[base]+'@+'+s+')'
  103.                       else
  104.                         s:=mit_reg2str[base]+'@+';
  105.                     end
  106.                   else
  107.                    InternalError(10002);
  108.                 end
  109.                 else if (index=R_NO) and (base<>R_NO) and (direction=dir_dec) then
  110.                 begin
  111.                   if (scalefactor = 1) or (scalefactor = 0) then
  112.                     Begin
  113.                       if offset<>0 then
  114.                          s:=mit_reg2str[base]+'@-'+s+')'
  115.                       else
  116.                          s:=mit_reg2str[base]+'@-';
  117.                     end
  118.                   else
  119.                    InternalError(10003);
  120.                 end
  121.               else if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then
  122.                 begin
  123.                   if (offset=0) and (symbol=nil) then
  124.                      s:=mit_reg2str[base]+'@'
  125.                   else
  126.                      s:=mit_reg2str[base]+'@'+s+')';
  127.                 end
  128.               else if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then
  129.                 begin
  130.                   s:=mit_reg2str[base]+'@'+s+','+mit_reg2str[index]+':L';
  131.                   if (scalefactor = 1) or (scalefactor = 0) then
  132.                       s:=s+')'
  133.                   else
  134.                      s:=s+':'+tostr(scalefactor)+')';
  135.                 end
  136.                 else
  137.                 if assigned(symbol) then
  138.                 Begin
  139.                    s:=symbol^;
  140.                    if offset<>0 then
  141.                      s:=s+'+'+tostr(offset);
  142.                 end
  143.                 { this must be a physical address }
  144.                 else
  145.                   s:=s+')';
  146. {                else if NOT assigned(symbol) then
  147.                   InternalError(10004);}
  148.             end; { end with }
  149.          getreferencestring:=s;
  150.       end;
  151.  
  152.  
  153.     function getopstr(t : byte;o : pointer) : string;
  154.       var
  155.          hs : string;
  156.          i: tregister;
  157.       begin
  158.          case t of
  159.             top_reg : getopstr:=mit_reg2str[tregister(o)];
  160.                top_ref : getopstr:=getreferencestring(preference(o)^);
  161.          top_reglist: begin
  162.                       hs:='';
  163.                       for i:=R_NO to R_FPSR do
  164.                       begin
  165.                         if i in tregisterlist(o^) then
  166.                          hs:=hs+mit_reg2str[i]+'/';
  167.                       end;
  168.                       delete(hs,length(hs),1);
  169.                       getopstr := hs;
  170.                     end;
  171.              top_const : getopstr:='#'+tostr(longint(o));
  172.             top_symbol :
  173.                     { compare with i386, where a symbol is considered }
  174.                     { a constant.                                     }
  175.                     begin
  176.                      hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  177.                             move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  178. {                           inc(byte(hs[0]));}
  179.                             if pcsymbol(o)^.offset>0 then
  180.                               hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  181.                             else if pcsymbol(o)^.offset<0 then
  182.                               hs:=hs+tostr(pcsymbol(o)^.offset);
  183.                             getopstr:=hs;
  184.                          end;
  185.             else internalerror(10001);
  186.          end;
  187.       end;
  188.  
  189.  
  190.     function getopstr_jmp(t : byte;o : pointer) : string;
  191.       var
  192.          hs : string;
  193.       begin
  194.          case t of
  195.             top_reg : getopstr_jmp:=mit_reg2str[tregister(o)];
  196.             top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
  197.             top_const : getopstr_jmp:=tostr(longint(o));
  198.             top_symbol : begin
  199.                             hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  200.                             move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  201.                             if pcsymbol(o)^.offset>0 then
  202.                               hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  203.                             else if pcsymbol(o)^.offset<0 then
  204.                               hs:=hs+tostr(pcsymbol(o)^.offset);
  205.                             getopstr_jmp:=hs;
  206.                          end;
  207.             else internalerror(10001);
  208.          end;
  209.       end;
  210.  
  211.  
  212. {****************************************************************************
  213.                              T68kGASASMOUTPUT
  214.  ****************************************************************************}
  215.  
  216.     var
  217.        { different types of source lines }
  218.        n_line : byte;
  219.  
  220.     const
  221.       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
  222.         (#9'.long'#9,'',#9'.short'#9,#9'.byte'#9);
  223.  
  224.     procedure tm68kmitasmlist.WriteTree(p:paasmoutput);
  225.     var
  226.       hp        : pai;
  227.       ch        : char;
  228.       consttyp  : tait;
  229.       s         : string;
  230.       pos,l,i   : longint;
  231.       found     : boolean;
  232. {$ifdef GDB}
  233.       funcname  : pchar;
  234.       linecount : longint;
  235. {$endif GDB}
  236.